home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Customer_I20373612122006.psc / OP Final / frmAbout.frm < prev    next >
Text File  |  2006-03-13  |  13KB  |  315 lines

  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    AutoRedraw      =   -1  'True
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "                                       About CustInfo"
  6.    ClientHeight    =   3750
  7.    ClientLeft      =   3210
  8.    ClientTop       =   3270
  9.    ClientWidth     =   7890
  10.    ClipControls    =   0   'False
  11.    Icon            =   "frmAbout.frx":0000
  12.    LinkTopic       =   "Form2"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    Moveable        =   0   'False
  16.    ScaleHeight     =   2588.317
  17.    ScaleMode       =   0  'User
  18.    ScaleWidth      =   7409.118
  19.    Begin VB.PictureBox picIcon 
  20.       AutoSize        =   -1  'True
  21.       BorderStyle     =   0  'None
  22.       ClipControls    =   0   'False
  23.       Height          =   480
  24.       Left            =   240
  25.       Picture         =   "frmAbout.frx":0442
  26.       ScaleHeight     =   337.12
  27.       ScaleMode       =   0  'User
  28.       ScaleWidth      =   337.12
  29.       TabIndex        =   1
  30.       Top             =   240
  31.       Width           =   480
  32.    End
  33.    Begin VB.CommandButton cmdOK 
  34.       Cancel          =   -1  'True
  35.       Caption         =   "OK"
  36.       Default         =   -1  'True
  37.       BeginProperty Font 
  38.          Name            =   "Tahoma"
  39.          Size            =   8.25
  40.          Charset         =   238
  41.          Weight          =   700
  42.          Underline       =   0   'False
  43.          Italic          =   0   'False
  44.          Strikethrough   =   0   'False
  45.       EndProperty
  46.       Height          =   345
  47.       Left            =   6525
  48.       TabIndex        =   0
  49.       Top             =   2685
  50.       Width           =   1320
  51.    End
  52.    Begin VB.CommandButton cmdSysInfo 
  53.       Caption         =   "System Info"
  54.       BeginProperty Font 
  55.          Name            =   "Tahoma"
  56.          Size            =   8.25
  57.          Charset         =   238
  58.          Weight          =   700
  59.          Underline       =   0   'False
  60.          Italic          =   0   'False
  61.          Strikethrough   =   0   'False
  62.       EndProperty
  63.       Height          =   345
  64.       Left            =   6540
  65.       TabIndex        =   2
  66.       Top             =   3135
  67.       Width           =   1320
  68.    End
  69.    Begin VB.Line Line1 
  70.       BorderColor     =   &H00808080&
  71.       BorderStyle     =   6  'Inside Solid
  72.       Index           =   1
  73.       X1              =   84.515
  74.       X2              =   7409.118
  75.       Y1              =   1687.583
  76.       Y2              =   1687.583
  77.    End
  78.    Begin VB.Label lblDescription 
  79.       AutoSize        =   -1  'True
  80.       BackStyle       =   0  'Transparent
  81.       Caption         =   "App Description"
  82.       BeginProperty Font 
  83.          Name            =   "Tahoma"
  84.          Size            =   9.75
  85.          Charset         =   0
  86.          Weight          =   700
  87.          Underline       =   0   'False
  88.          Italic          =   0   'False
  89.          Strikethrough   =   0   'False
  90.       EndProperty
  91.       ForeColor       =   &H00000000&
  92.       Height          =   240
  93.       Left            =   1050
  94.       TabIndex        =   3
  95.       Top             =   1125
  96.       Width           =   1545
  97.    End
  98.    Begin VB.Label lblTitle 
  99.       BackStyle       =   0  'Transparent
  100.       Caption         =   "CUSTOMER INFORMATION MAINTENANCE SYSTEM"
  101.       BeginProperty Font 
  102.          Name            =   "Tahoma"
  103.          Size            =   9.75
  104.          Charset         =   0
  105.          Weight          =   700
  106.          Underline       =   0   'False
  107.          Italic          =   0   'False
  108.          Strikethrough   =   0   'False
  109.       EndProperty
  110.       ForeColor       =   &H00000000&
  111.       Height          =   480
  112.       Left            =   1035
  113.       TabIndex        =   5
  114.       Top             =   240
  115.       Width           =   4965
  116.    End
  117.    Begin VB.Line Line1 
  118.       BorderColor     =   &H00FFFFFF&
  119.       BorderWidth     =   2
  120.       Index           =   0
  121.       X1              =   98.6
  122.       X2              =   5309.398
  123.       Y1              =   1697.936
  124.       Y2              =   1697.936
  125.    End
  126.    Begin VB.Label lblVersion 
  127.       BackStyle       =   0  'Transparent
  128.       Caption         =   "Version"
  129.       BeginProperty Font 
  130.          Name            =   "Tahoma"
  131.          Size            =   9.75
  132.          Charset         =   0
  133.          Weight          =   700
  134.          Underline       =   0   'False
  135.          Italic          =   0   'False
  136.          Strikethrough   =   0   'False
  137.       EndProperty
  138.       Height          =   225
  139.       Left            =   1050
  140.       TabIndex        =   6
  141.       Top             =   765
  142.       Width           =   3885
  143.    End
  144.    Begin VB.Label lblDisclaimer 
  145.       AutoSize        =   -1  'True
  146.       BackStyle       =   0  'Transparent
  147.       Caption         =   "Warning: ..."
  148.       BeginProperty Font 
  149.          Name            =   "Tahoma"
  150.          Size            =   9.75
  151.          Charset         =   0
  152.          Weight          =   700
  153.          Underline       =   0   'False
  154.          Italic          =   0   'False
  155.          Strikethrough   =   0   'False
  156.       EndProperty
  157.       ForeColor       =   &H00000000&
  158.       Height          =   240
  159.       Left            =   105
  160.       TabIndex        =   4
  161.       Top             =   2505
  162.       Width           =   1125
  163.    End
  164. End
  165. Attribute VB_Name = "frmAbout"
  166. Attribute VB_GlobalNameSpace = False
  167. Attribute VB_Creatable = False
  168. Attribute VB_PredeclaredId = True
  169. Attribute VB_Exposed = False
  170. Option Explicit
  171.  
  172. ' Reg Key Security Options...
  173. Const READ_CONTROL = &H20000
  174. Const KEY_QUERY_VALUE = &H1
  175. Const KEY_SET_VALUE = &H2
  176. Const KEY_CREATE_SUB_KEY = &H4
  177. Const KEY_ENUMERATE_SUB_KEYS = &H8
  178. Const KEY_NOTIFY = &H10
  179. Const KEY_CREATE_LINK = &H20
  180. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  181.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  182.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  183.                      
  184. ' Reg Key ROOT Types...
  185. Const HKEY_LOCAL_MACHINE = &H80000002
  186. Const ERROR_SUCCESS = 0
  187. Const REG_SZ = 1                         ' Unicode nul terminated string
  188. Const REG_DWORD = 4                      ' 32-bit number
  189.  
  190. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  191. Const gREGVALSYSINFOLOC = "MSINFO"
  192. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  193. Const gREGVALSYSINFO = "PATH"
  194.  
  195. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  196. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  197. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  198.  
  199.  
  200. Private Sub cmdSysInfo_Click()
  201.   Call StartSysInfo
  202. End Sub
  203.  
  204. Private Sub cmdOK_Click()
  205.   Unload Me
  206.   frmmain.Show
  207. End Sub
  208.  
  209. Public Sub StartSysInfo()
  210.     On Error GoTo SysInfoErr
  211.   
  212.     Dim rc As Long
  213.     Dim SysInfoPath As String
  214.     
  215.     ' Try To Get System Info Program Path\Name From Registry...
  216.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  217.     ' Try To Get System Info Program Path Only From Registry...
  218.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  219.         ' Validate Existance Of Known 32 Bit File Version
  220.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  221.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  222.             
  223.         ' Error - File Can Not Be Found...
  224.         Else
  225.             GoTo SysInfoErr
  226.         End If
  227.     ' Error - Registry Entry Can Not Be Found...
  228.     Else
  229.         GoTo SysInfoErr
  230.     End If
  231.     
  232.     Call Shell(SysInfoPath, vbNormalFocus)
  233.     
  234.     Exit Sub
  235. SysInfoErr:
  236.     MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  237. End Sub
  238.  
  239. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  240.     Dim i As Long                                           ' Loop Counter
  241.     Dim rc As Long                                          ' Return Code
  242.     Dim hKey As Long                                        ' Handle To An Open Registry Key
  243.     Dim hDepth As Long                                      '
  244.     Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  245.     Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  246.     Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  247.     '------------------------------------------------------------
  248.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  249.     '------------------------------------------------------------
  250.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  251.     
  252.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  253.     
  254.     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  255.     KeyValSize = 1024                                       ' Mark Variable Size
  256.     
  257.     '------------------------------------------------------------
  258.     ' Retrieve Registry Key Value...
  259.     '------------------------------------------------------------
  260.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  261.                          KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  262.                         
  263.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  264.     
  265.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
  266.         tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
  267.     Else                                                    ' WinNT Does NOT Null Terminate String...
  268.         tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
  269.     End If
  270.     '------------------------------------------------------------
  271.     ' Determine Key Value Type For Conversion...
  272.     '------------------------------------------------------------
  273.     Select Case KeyValType                                  ' Search Data Types...
  274.     Case REG_SZ                                             ' String Registry Key Data Type
  275.         KeyVal = tmpVal                                     ' Copy String Value
  276.     Case REG_DWORD                                          ' Double Word Registry Key Data Type
  277.         For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  278.             KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  279.         Next
  280.         KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  281.     End Select
  282.     
  283.     GetKeyValue = True                                      ' Return Success
  284.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  285.     Exit Function                                           ' Exit
  286.     
  287. GetKeyError:      ' Cleanup After An Error Has Occured...
  288.     KeyVal = ""                                             ' Set Return Val To Empty String
  289.     GetKeyValue = False                                     ' Return Failure
  290.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  291. End Function
  292.  
  293. Private Sub Form_Load()
  294. Left = (Screen.Width - Width) \ 2
  295. Top = (Screen.Height - Height) \ 2
  296.  
  297. lblVersion.Caption = "Version Info : " & App.Major & "." & App.Minor & "." & App.Revision
  298. lblDescription.Caption = "Developed By : Shouvik Choudhury" & Chr(10) & _
  299.                           "Supported && Advised By : Mr. Subrata Santra" & Chr(10) & _
  300.                           "Legal Copyright : Computer Valley" & Chr(10) & _
  301.                           "Contact Address : 399/1,Unique Park,Behala,Kol-34"
  302. lblDisclaimer.Caption = "Warning : This computer program is protected by copyright" & Chr(10) & _
  303.                         "law and international treaties.Unauthorised reproduction or" & Chr(10) & _
  304.                         "distribution of files or any portion of it,may result in severe" & Chr(10) & _
  305.                         "civil and criminal penalties and will be procecuted to the" & Chr(10) & _
  306.                         "maximum extent posible under law."
  307.                         
  308.  
  309. End Sub
  310.  
  311. Private Sub Form_Unload(Cancel As Integer)
  312. Unload Me
  313. frmmain.Show
  314. End Sub
  315.